home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
aijournl
/
1988_08
/
codebox.asc
next >
Wrap
Text File
|
1988-05-04
|
20KB
|
547 lines
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generating List Mapping Predicates
program_list_map( Predicate_name,
Element_predicate) :-
% build the head for the null list rule
Null_list_rule_head =.. [ Predicate_name, [] , [] ],
% assert the null list rule, including a cut
asserta(( Null_list_rule_head :- !)),
% build recursive rule head
Recursive_rule_head =.. [ Predicate_name, [H | T] , [H1 | T1] ],
% build call for Element_predicate
Element_predicate_call =.. [ Element_predicate , H, H1 ],
% build recursive call
Recursive_call =.. [ Predicate_name , T, T1 ],
% assert recursive rule
assertz( ( Recursive_rule_head :-
Element_predicate_call,
Recursive_call )).
Box 1
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A Program Scheme with Comments
$ /* Predicate_name User_defined_purpose */
/* Predicate_name maps null set into null set */
Predicate_name( [], []) :- !.
/* recursive rule for Predicate_name */
Predicate_name( [H|T], [H1|T1]) :-
/* apply Element_predicate to head of list */
Element_predicate( H, H1),
/* recurse with Predicate_name on tail of list */
Predicate_name(T, T1). $,
Box 2
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Information in a Programmer's Scheme
[comment([$/*$, var($Predicate_name$),
var($User_defined_purpose$), $*/$]),
comment([$/*$, var($Predicate_name$),
$maps$, $null$, $set$, $into$, $null$, $set$, $*/$]),
rule((var_functor_term(var($Predicate_name$),[[],[]]) :- [$!$])),
comment([$/*$,$recursive$,$rule$,$for$,var($Predicate_name$),$*/$]),
rule((var_functor_term(var($Predicate_name$),
[[var($H$) | var($T$)],
[var($H1$) | var($T1$)]]) :-
[ comment([$/*$, $apply$, var($Element_predicate$),
$to$, $head$, $of$, $list$, $*/$]),
var_functor_term(var($Predicate_name$),
[var($H1$) , var($H1$)]),
comment([$/*$, $recurse$, $with$,
var($Predicate_name$), $*/$]),
var_functor_term(var($Predicate_name$),
[var($T1$) , var($T1$)]) ]))]
Box 4
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A BNF for Prolog Program Schemes
% a schema definition is a list of items (clauses or comments)
scheme_def --> item | scheme_def | []
% an item is a clause or comment
item --> clause | comment
% an clause is a fact or rule
clause --> fact | rule
% a fact is a term followed by a period
fact --> term .
% a rule is a term (the head) followed by the neck symbol
% followed by a (rule) body followed by a period
rule --> term :- body .
% a body is a comment followed by body
% or a term followed by a comma followed by a body
% or a term or a comment
body --> comment body | term , body | term | comment
% a term is a functor symbol followed by an argument list
% or a set or a constant or a variable
term --> functor_symbol arg_list | set | constant | variable
% an arg_list is a term_list in parens
arg_list --> ( termlist )
% a term_list is a term followed by a ter_list or a term
term_list --> term term_list | term
% a functor symbol is an atom or variable
functor_symbol --> atom | variable
% a set is a list of terms or the empty list
set --> [ set_termlist | []
% a termlist is a term followed by a comma followed by a termlist
% or a term followed by a right bracket
% or a term, a bar, a term, and a right bracket
set_termlist --> term, set_termlist | term ] | term bar term ]
% def. of bar
bar --> |
% a comment is a comment starter followed by a (comment)
% word list
comment --> start_comment word_list
% a word_list is a word followed by a word_list
% or an end of comment
word_list --> word word_list | end_comment
% a word is a variable or a token
word --> variable | token
start_comment --> /*
end_comment --> */
Box 5
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A Definite Clause Grammar for Schemes
scheme_def(Scheme) --> item(H), scheme_def( T),
{Scheme= [ H | T],
p_trace($Scheme : $, Scheme)},!.
scheme_def([],[],[]) :- p_trace($Scheme = [] $),!.
item(X) --> fact(X) , !,{p_trace($item : $, X)}.
item(X) --> rule(X) , !,{p_trace($item : $, X)}.
item(X) --> comment(X) , !,{p_trace($item : $, X)}.
fact(fact(Fact)) --> term( Fact), [$.$],
{p_trace($Fact : $,Fact)}.
rule(Rule) --> term(Head), [$:-$],
{p_trace($starting rule body$)},
body(Body),
{Rule = rule((Head :- Body)),
p_trace($Rule : $,Rule)}.
body( Body ) --> comment(H), body(T),!,
{ Body = [H | T],
p_trace($Body : $,Body)}.
body( Body ) --> term(H), [$,$], body(T),!,
{ Body = [H | T],
p_trace($Body : $,Body)}.
body( [Term]) --> term( Term), [$.$],!,
{p_trace($Body : $, Term)}.
body( [Comment]) --> comment(Comment), [$.$],!,
{p_trace($Body : $, Comment)}.
% a term is a functor symbol followed by an argument list
% or a set or a constant or a variable or a set
term(Term) --> variable(Variable), [$($],
{p_trace($entering arg_list $)},
arg_list(Arg_list), !,
{Term = var_functor_term( Variable, Arg_list),
p_trace($term: $,Term)}.
term(Term) --> is_atom(X), [$($], arg_list(Arg_list), !,
{Term = const_functor_term( X, Arg_list),
p_trace($term: $,Term)}.
term(X) --> set(X), ! , { p_trace($term: $,X)}.
term(X) --> is_atomic(X), ! , { p_trace($term: $,X)}.
term(X) --> variable(X), ! , { p_trace($term: $,X)}.
arg_list(Arglist = [Term | Termlist]) --> term(Term) ,
arg_list_hlpr(Termlist),!,
{ Arglist = [Term | Termlist],
p_trace($arg_list: $,Arglist)}.
arg_list_hlpr([]) --> [$)$] , !,
{ p_trace($arg_list_hlpr: []$)}.
arg_list_hlpr(Termlist) --> [$,$] , arg_list( Termlist) , !,
{ p_trace($arg_list_hlpr: $,
Termlist )}.
% set --> [ termlist
set( Set ) --> [$[$], termlist(Set),!,{p_trace($Set : $,Set)}.
% set --> [ ]
set( Set ) --> [$[$,$]$],{Set = [], p_trace($Set : $,Set)}.
termlist(Termlist) --> term(H), termlist_hlpr(T),
{ Termlist = [H | T],
p_trace($termlist : $, Termlist)}.
termlist_hlpr([]) --> [$]$],!,{p_trace($termlist : []$)}.
termlist_hlpr(T) --> [$|$], term(T),[$]$],!,
{p_trace($termlist : $, T)}.
termlist_hlpr(T) --> comma($,$), termlist(T), !,
{p_trace($termlist : $, T)}.
comment( Comment ) --> start_comment( H), word_list(T),
{ Comment = comment([H | T]),
p_trace($Comment : $,Comment) }.
% the straightforward implementation, like that of
% start_comment, did not work properly
end_comment($*/$) --> [$*/$].
start_comment($/*$) --> [$/*$].
% word_list --> word word_list | end_comment
word_list( [H | T] ) --> word(H), word_list( T ), !.
word_list( [H] ) --> end_comment( H ).
% word --> variable | token
word(X) --> variable(X),!.
% don't let an end of comment be a word
word(X) --> end_comment(X), !, {fail}.
word(X) --> token(X).
% returns a variable inside a var(*) marker
variable(var(X)) --> [X], % get the next token
% get its first character
{nth_char(0,X,Char),
% see if it's upper case
is_uc(Char)}.
% get an atom from input stream
is_atom(X) --> [X], % get the next token
% get its first character
{nth_char(0,X,Char),
% see if it's lower case
is_lc(Char)}.
% get an atomic structure from input stream
is_atomic(X) --> [X], % get the next token
% see if it's atomic
{atomic(X)},!.
comma(X) --> [$,$],!.
% returns an arbitrary token as itself
token(X) --> [X],!.
Box 6
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A User-Supplied Scheme Fact
scheme( program_list_map,
$ /* Predicate_name User_defined_purpose */
.......................
< complete scheme from Box 2 goes here>
.......................
Predicate_name(T, T1). $,
[ $Predicate_name$ : $name of predicate to be defined$,
$User_defined_purpose$ :
$description of what the predicate does$,
$Element_predicate$ : $predicate that maps set elements$]).
Box 7
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Converting a Scheme to Internal Form
preprocess( scheme( Name, Scheme, Table),
internal_scheme( Name, Internal_Scheme,
Table) :-
% tokenize the input
tokenize(Scheme, Tokens),
% build scheme semantic structure
scheme_def( Internal_Scheme, Tokens, []).
Box 8
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Top Level of Code Generation
% generate code from a scheme given its name
process( Scheme_name) :-
% look up internal scheme
internal_scheme( Name, Internal_Scheme,
Table),
% get the values of variables in Table,
get_variable_values(Table, Values),
% get temporary file for code
temporary_file_handle(Temp_file_name, Temp_file_handle),
% get the file name where the code should go permanently
get_destination_file(Peramanent_filename),
% generate the code
generate_code(Temp_file_handle, Values, Internal_Scheme),
% close temp file
close( Temp_file_handle ),
% append code to the permanent file
append_files( Temp_file_name, Peramanent_filename).
% get the values of variables in a scheme Table
get_variable_values(Table, Values) :-
% get Table in reverse order to make questions
% come out in forward order during recursion
reverse(Table, Reversed_table),
% ask questions and build frame of variable values
ask_questions( Reversed_table, Values0),
% put attribautes back in original order
reverse(Values0, Values).
% ask questions and build frame of variable values
ask_questions( [], [] ) :- !.
ask_questions( [H | T], [H1 | T1] ) :-
ask_question(H , H1),
ask_questions(T , T1).
% ask the user a question
ask_question( Variable : Question,
Variable : Value) :-
% write question to screen
write( Question),write($ ? $),
% read user response
read_line(1, Value).
% append File2 to File1
append_files( File1, File2) :-
% build a DOS copy command that appends files
concat([$copy $,File1,$+$,File2,$,$,File1],Cmd),
% send it to DOS
shell(Cmd).
Box 10
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Code Generation
% generate the output code. Scheme is input stream.
% This is written as a Prolog predicate instead of
% a grammar rule because of a suspected bug in the DCG
% translator
generate_code_hlpr(Temp_file_handle, Values,
% does the input start with a comment
[comment(X) | Rest],
Left_over) :-
o_trace($e generate_code_hlpr$),
% generate initial comment with 0 indent
generate_comment( Temp_file_handle, Values, 0,
[comment(X)],[]),!,
% blank line after this comment
nl(Temp_file_handle),
o_trace($a initial comment$),
% generate each clause in turn
generate_clauses( Temp_file_handle, Values,
Rest, Left_over).
generate_code_hlpr(Temp_file_handle, Values) -->
% otherwise just generate clauses
generate_clauses( Temp_file_handle, Values).
generate_comment( Handle, Values, Offset) -->
{o_trace($e generate_comment$)},
[comment([$/*$ | X])],
{ nl(Handle), tab(Handle,Offset), write(Handle, $/*$),
generate_comment_hlpr( Handle,
Values, X, [])},!.
generate_comment_hlpr( Handle, Values) -->
[$*/$],{write_spaced_token(Handle,$*/$)},!.
generate_comment_hlpr( Handle, Values) -->
scheme_token( Values, Value),
{write_spaced_token(Handle, Value)},
generate_comment_hlpr( Handle, Values).
write_spaced_token(Handle, Value) :-
tab(Handle, 1), write(Handle, Value).
scheme_token( Values, Value) -->
[var(Indicator)],!,
{get_frame_value_with_default(Values, Indicator,
Indicator, Value),
o_trace($Token = $,Value)}.
scheme_token( Values, Value) --> [Value],
{o_trace($Token = $, Value)}.
%%%%%%%%%%%%%%%%%%% tests %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test :- generate_code(1, % put output to screen for test
% Here are the values of the template variables
[$Predicate_name$ : list_of_types,
$User_defined_purpose$ :
$maps a list into a list of types elementwise$,
$Element_predicate$ : type],
% Here is the processed template
[comment([$/*$, var($Predicate_name$),
var($User_defined_purpose$), $*/$]),
comment([$/*$, var($Predicate_name$),
$maps$, $null$, $set$, $into$, $null$, $set$, $*/$]),
rule((var_functor_term(var($Predicate_name$),[[],[]]) :- [$!$])),
comment([$/*$,$recursive$,$rule$,$for$,var($Predicate_name$),$*/$]),
rule((var_functor_term(var($Predicate_name$),
[[var($H$) | var($T$)],
[var($H1$) | var($T1$)]]) :-
[ comment([$/*$, $apply$, var($Element_predicate$),
$to$, $head$, $of$, $list$, $*/$]),
var_functor_term(var($Element_predicate$),
[var($H1$) , var($H1$)]),
comment([$/*$, $recurse$, $with$,
var($Predicate_name$), $*/$]),
var_functor_term(var($Predicate_name$),
[var($T1$) , var($T1$)]) ]))]
).
Box 11
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Retrieval from Frames
/* This predicate gets a Value from a Frame given an Indicator
(slot name). It gets the Value stored in the frame if there
is one, and Default otherwise.
*/
% rule after frame is searched
get_frame_value_with_default( [], _, Default, Default) :-!.
% rule for when the value is in the first pair
get_frame_value_with_default( [Indicator : Value | _],
Indicator, _, Value):- !.
% recursive rule
get_frame_value_with_default( [_|T], Indicator, Default, Value) :-
get_frame_value_with_default( T, Indicator, Default, Value).
Box 12
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A Test of the Code Generator
/* Here is the test: the box 2 template with some scheme
variable values. */
test :- generate_code(1, % put output to screen for test
% Here are the values of the template variables
[$Predicate_name$ : list_of_types,
$User_defined_purpose$ :
$maps a list into a list of types elementwise$,
$Element_predicate$ : type],
% Here is the processed template
[comment([$/*$, var($Predicate_name$),
var($User_defined_purpose$), $*/$]),
comment([$/*$, var($Predicate_name$),
$maps$, $null$, $set$, $into$, $null$, $set$, $*/$]),
rule((var_functor_term(var($Predicate_name$),[[],[]]) :- [$!$])),
comment([$/*$,$recursive$,$rule$,$for$,var($Predicate_name$),$*/$]),
rule((var_functor_term(var($Predicate_name$),
[[var($H$) | var($T$)],
[var($H1$) | var($T1$)]]) :-
[ comment([$/*$, $apply$, var($Element_predicate$),
$to$, $head$, $of$, $list$, $*/$]),
var_functor_term(var($Element_predicate$),
[var($H1$) , var($H1$)]),
comment([$/*$, $recurse$, $with$,
var($Predicate_name$), $*/$]),
var_functor_term(var($Predicate_name$),
[var($T1$) , var($T1$)]) ]))]
).
/* Here is the generated code: */
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/* list_of_types maps a list into a list of types elementwise */
/* list_of_types maps null set into null set */
list_of_types([], []) :-
!.
/* recursive rule for list_of_types */
list_of_types([H | T], [H1 | T1]) :-
/* apply type to head of list */
type(H1, H1),
/* recurse with list_of_types */
list_of_types(T1, T1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Box 13
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A Scheme for Selecting a Scheme
internal_scheme(
sort,
[$memory_size$ : $how much memory do you have$,
$sort_size$ : $how many items do you have to sort$,
$item_size$ : $how big is each item$],
sort_helper).
sort_helper( Variables) :-
get_frame_value(Variables, $memory_size$, Memory),
get_frame_value(Variables, $sort_size$, Items),
get_frame_value(Variables, $item_size$, Size),
select_sort( Memory, Items, Size).
select_sort( Memory, Items, Size) :-
Size < 20,
process(insert_sort).
select_sort( Memory, Items, Size) :-
Required is Items * Size + 10E5,
Memory > Required,
process(quick_sort).
select_sort( _, _, _) :-
process(merge_sort).
Box 14
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
process(merge_sort).
Box 14
~~~~~~~~~~~~~~~~~~~~~~